;;; Copyright © 2020 Maxime Devos <maximedevos@telenet.be>
;;; This file is part of rehash.
;;;
;;; rehash is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; rehash is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with rehash.  If not, see <http://www.gnu.org/licenses/>.
(define-library (remirror web)
  (export xxx-start!)
  (import (rnrs base)
	  (ice-9 threads)
	  (guile)
	  (sxml simple)
	  (rename (fibers web server)
		  (run-server fibers:run-server))
	  (only (srfi srfi-11) let-values)
	  (web client)
	  (web server)
	  (web request)
	  (web response)
	  (web uri))

  (begin
    (define (request-path-components request)
      (split-and-decode-uri-path (uri-path (request-uri request))))

    ;; FIXME incorrect behaviour for proxy
    ;; FIXME distinguish between GET, POST, HEAD, ...

    (define (not-found request)
      (values (build-response #:code 404)
	      (string-append "remirror doesn't support this endpoint: "
			     (uri->string (request-uri request)))))

    (define* (sxml-response sxml
			   #:key (status 200))
      (values (build-response
	       #:code status
	       #:headers `((content-type
			    . (text/html (charset . "utf-8")))))
	      (lambda (port)
		(display "<!DOCTYPE html>\n" port)
		(sxml->xml sxml port))))

    (define (handler/top-level request request-body)
      (sxml-response
       '(html (head (title "rehash-remirror"))
	      (body (p "Hi! Here are some links: "
		       (a (@ (href "/web"))
			  "web interface to remirror")
		       ", "
		       (a (@ (href "https://notabug.org/mdevos/rehash"))
			  "source code of rehash & remirror")
		       ", "
		       (a (@ (href "https://gnunet.org"))
			  "GNUnet"))))))

    (define (handler/web request request-body)
      (sxml-response
       '(html (head (title "rehash-remirror web"))
	      (body (p "Some parts of the rehash-remirror web interface:")
		    (ul (li (a (@ (href "/web/active-downloads"))
			       "list of in-progress downloads"))
			(li (a (@ (href "/web/statistics"))
			       "some statistics"))
			(li (a (@ (href "/web/tuning"))
			       "some settings")))))))

    (define (handler/proxy request request-body)
      ;; FIXME how are we supposed to support HTTPS?
      ;; (maybe just use a snake oil certificate?)
      (case (request-method request)
	((GET) (handler/proxy-get request request-body))
	((CONNECT) (handler/connect request request-body))
	(else (throw 'eep))))

    (define (handler/proxy-get request request-body)
      ;; FIXME add to download list
      ;; FIXME GNUnet
      ;; FIXME respect relevant Internet RFCs
      ;; FIXME fibers
      ;; FIXME more FIXME
      (if request-body
	  (throw 'eep))
      (let-values (((response response-body)
		    ;; FIXME headers
		    (http-get (request-uri request)
			      #:decode-body? #f
			      #:streaming? #f)))
	(values response response-body)))

    (define (handler/connect request request-body)
      ;; Where to connect to?
      (let* ((host (or (request-host request '(#f . #f))))
	     (hostname (car host))
	     (port (cdr host)))
	(cond ((and hostname (equal? port 443))
	       ;; Impersonate the HTTPS server
	       (throw 'eep-impersonate))
	      (else
	       #;(write hostname)
	       #;(write host)
	       (throw 'eep-twice)))))

    ;; Tip: 7.3.10.1 Hello, World! provides a good
    ;; start at writing a web server.
    (define (handler request request-body)
      ;;      (write request) (newline)
      (let* ((components (request-path-components request))
	     (handle
	      (lambda (handler)
		(handler request request-body))))
	;; TODO proxy
	(cond ((uri-scheme (request-uri request))
	       (handle handler/proxy))
	      ((equal? components '())
	       (handle handler/top-level))
	      ((equal? components '("web"))
	       (handle handler/web))
	      ((equal? components '("web" "active-downloads"))
	       (handle handler/web-active-downloads))
	      ((equal? components '("web" "statistics"))
	       (handle handler/web-statistics))
	      ((equal? components '("web" "tuning"))
	       (handle handler/web-tuning))
	      (#t (not-found request)))))

    ;; FIXME configuration, fibers
    (define (xxx-start!)
      (parameterize ((%active-downloads '()))
	(fibers:run-server handler #:port 8081)))

    ;; List of in-progress downloads
    (define %active-downloads (make-parameter #f))))
